home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / Libraries / SAT 2.3.8 / Demos / HeartQuest demo ƒ / scores.p < prev    next >
Text File  |  1996-06-25  |  13KB  |  479 lines
  1. {================================================}
  2. {============= Score handling and display ==============}
  3. {================================================}
  4.  
  5. { Example file for Ingemars Sprite Animation Toolkit. }
  6. { © Ingemar Ragnemalm 1992 }
  7. { See doc files for legal terms for using this code. }
  8.  
  9. { This file manages the display and update of the game scores for HeartQuest.}
  10. { It holds routines for updating high score list, including asking for the name of}
  11. { the player, high score window etc. When making a new game, you will probably}
  12. { need to rewrite this unit a lot. }
  13.  
  14. unit scores;
  15.  
  16. interface
  17.     uses
  18. {$IFC UNDEFINED THINK_PASCAL}
  19.         Types, Quickdraw, ToolUtils, Resources, Dialogs, Events, Controls,{}
  20.         Windows, TextUtils, QuickDrawText, Memory, MixedMode,
  21. {$ELSEC}
  22.         InterfacesUI, 
  23. {$ENDC}
  24.         TransSkel, SAT, Preferences, GameGlobals, SoundConst, CenterStuff;
  25.  
  26.     var
  27.         score: longint;
  28.  
  29.     procedure DoHighMenu (item: integer);
  30.     procedure InitScores;                    { Loads the high score list and the high score window. }
  31.     procedure ZeroScore;                     { Call this on New Game! }
  32.     procedure AddScore (amount: longint);    { Call this when the player gets points, or with addscore(0) just to redisplay. }
  33.     procedure AddScoreS (amount: longint);    { Call this to redisplay when the animation isn't running. }
  34.     procedure UpdateHigh;                    { Call this on game over! }
  35.  
  36. implementation
  37.  
  38. { Highscore record }
  39.     type
  40.         hsRec = record
  41.                 HighScores: array[0..10] of longint;
  42.                 HighPlayer: array[0..10] of str15;
  43.             end;
  44.         hsPtr = ^hsRec;
  45.         hsHnd = ^hsPtr;
  46.  
  47.  
  48.     var
  49.         hs, hsm: hsHnd; { m is for macho mode }
  50.         hsh, hshm: Handle;
  51.  
  52. {Filter function for AskHigh, ok = 1 and cancel = 4}
  53.     function Filter (theDialog: DialogPtr; var theEvent: EventRecord; var itemHit: integer): boolean;
  54.         var
  55.             theChar: Char;
  56.             kind: integer;
  57.             item: Handle;
  58.             box: Rect;
  59.     begin
  60.         if theEvent.what = keyDown then
  61.             begin
  62.                 theChar := Char(BitAnd(theEvent.message, charCodeMask));
  63. {if BitAnd(theEvent.modifiers, cmdkey) <> 0 then}
  64. {if theChar = '.' then}
  65.                 if ((BitAnd(theEvent.modifiers, cmdkey) <> 0) and (theChar = '.')) or (theChar = char(27)) then {cmd-. or ESC}
  66.                     begin
  67.                         itemHit := 4;
  68. {Highlight the cancel button}
  69.                         GetDialogItem(theDialog, 4, kind, item, box);
  70.                         HiliteControl(ControlHandle(item), 1);
  71.  
  72.                         Filter := true;
  73.                         exit(Filter);
  74.                     end;
  75.                 if (theChar = char(13)) or (theChar = char(3)) then
  76.                     begin
  77.                         itemHit := 1;
  78. {Highlight the OK button}
  79.                         GetDialogItem(theDialog, 1, kind, item, box);
  80.                         HiliteControl(ControlHandle(item), 1);
  81.  
  82.                         Filter := true;
  83.                         exit(Filter);
  84.                     end;
  85.             end;
  86.         Filter := false;
  87.     end;
  88.  
  89. {Put a frame around a dialog item. There are better ways to do this, though. The right way}
  90. {is to draw the frame as response to an update event, not just when opening the dialog.}
  91.     procedure FrameDItem (dLog: DialogPtr; iNum: integer);
  92.         var
  93.             iBox: Rect;
  94.             iType: integer;
  95.             iHandle: Handle;
  96.             oldPenState: PenState;
  97.             tmpp: GrafPtr;
  98.     begin
  99.         GetPort(tmpp);
  100.         SetPort(dLog);
  101.         GetPenState(oldPenState);
  102.         GetDialogItem(dLog, iNum, iType, iHandle, iBox);
  103.         InsetRect(iBox, -4, -4);
  104.         PenSize(3, 3);
  105.         FrameRoundRect(iBox, 16, 16);
  106.         SetPenState(oldPenState);
  107.         SetPort(tmpp);
  108.     end;
  109.  
  110. { Ask for players name (at highscore) }
  111.     function AskHigh: str255;
  112.         var
  113.             dialog: DialogPtr;
  114.             oldPort: GrafPtr;
  115.             dRec: DialogRecord;
  116.             itemHit: integer;
  117.             itemHandle: Handle;
  118.             itemType, item: integer;
  119.             itemRect: Rect;
  120.             str: str255;
  121.             levelstr: str255;
  122. {$IFC GENERATINGPOWERPC }
  123.             filterProc: ProcPtr;
  124. {$ENDC}
  125.     begin
  126.         CenterDialog(highDlog);
  127.         GetPort(oldPort);
  128.         dialog := GetNewDialog(highDlog, @dRec, WindowPtr(-1));
  129.         ShowWindow(dialog);
  130.         SelectWindow(dialog);
  131.         SetPort(dialog);
  132.  
  133.         GetDialogItem(dialog, 3, itemType, itemHandle, itemRect);
  134.         SetDialogItemText(itemHandle, features^^.player);
  135.         SelectDialogItemText(dialog, 3, 0, 32767);
  136.         FrameDItem(dialog, 1);
  137.         itemHit := -1;
  138.  
  139. {$IFC GENERATINGPOWERPC }
  140.         filterProc := NewRoutineDescriptor(@Filter, uppModalFilterProcInfo, GetCurrentISA);
  141. {$ENDC}
  142.  
  143.         while (itemHit <> 1) and (itemHit <> 4) do { 1=ok, 4=cancel }
  144. {$IFC GENERATINGPOWERPC }
  145.             ModalDialog(filterProc, itemHit);
  146. {$ELSEC}
  147.         ModalDialog(@Filter, itemHit);
  148. {$ENDC}
  149.         if itemHit = 4 then
  150.             begin
  151.                 AskHigh := '';
  152.             end;
  153.         if itemHit = 1 then
  154.             begin
  155.                 GetDialogItem(dialog, 3, itemType, itemHandle, itemRect);
  156.                 GetDialogItemText(itemHandle, str);
  157.                 if length(str) > 15 then
  158.                     str := Copy(str, 1, 15);
  159.                 features^^.player := str;
  160.                 AskHigh := str;
  161.             end;
  162.         CloseDialog(dialog);
  163.         SetPort(oldPort);
  164.     end;
  165.  
  166. {     High Score window handlers }
  167.  
  168.     procedure HighUpdate (resized: boolean);
  169.         var
  170.             s: str255;
  171.             i: integer;
  172.     begin
  173.         EraseRect(theHigh^.portrect);
  174.         TextSize(9);
  175.  
  176.         moveto(10, 20);
  177.         DrawString(MyGetIndString(normalStrID)); {str 9: Normal high score list}
  178.         MoveTo(150, 20);
  179.         DrawString(MyGetIndString(machoStrID)); {str 10: Macho high score list}
  180.         MoveTo(0, 22);
  181.         LineTo(500, 22);
  182.         MoveTo(140, 0);
  183.         LineTo(140, 400);
  184.  
  185.         for i := 1 to 10 do
  186.             begin
  187.                 if not LastMacho and (i = LastHigh) then
  188.                     begin
  189.                         TextFace([bold]);
  190.                         ForeColor(redColor);
  191.                     end;
  192.                 moveto(10, i * 18 + 20);
  193.                 DrawString(hs^^.HighPlayer[i]);
  194.                 moveto(110, i * 18 + 20);
  195.                 NumToString(hs^^.HighScores[i], s);
  196.                 DrawString(s);
  197.  
  198.                 TextFace([]);
  199.                 ForeColor(BlackColor);
  200.                 if LastMacho and (i = LastHigh) then
  201.                     begin
  202.                         TextFace([bold]);
  203.                         ForeColor(redColor);
  204.                     end;
  205.                 moveto(150, i * 18 + 20);
  206.                 DrawString(hsm^^.HighPlayer[i]);
  207.                 moveto(250, i * 18 + 20);
  208.                 NumToString(hsm^^.HighScores[i], s);
  209.                 DrawString(s);
  210.  
  211.                 TextFace([]);
  212.                 ForeColor(BlackColor);
  213.             end;
  214.         TextSize(12);
  215.     end;
  216.  
  217.     procedure HighHalt;
  218.     begin
  219.         CloseWindow(theHigh);
  220.     end;
  221.  
  222.     function InternalAddScore (amount: longint): Rect;
  223.         var
  224.             s: str255;
  225.             r: Rect;
  226.     begin
  227.         score := score + amount;
  228.  
  229.         SetPort(gSAT.backScreen.port);
  230.         SetRect(r, gSAT.offSizeH - 49, 14, gSAT.offSizeH - 2, 155);
  231.         EraseRoundRect(r, 10, 10);
  232.         FrameRoundRect(r, 10, 10);
  233.         NumToString(Score, s);
  234.         MoveTo(gSAT.offSizeH - 47, 30);
  235.         DrawString(MyGetIndString(scoreStrID)); {str 11: Score: }
  236.         MoveTo(gSAT.offSizeH - 47, 50);
  237.         DrawString(s);
  238.  
  239.         if not bonusLevelRunning then
  240.             begin
  241.                 NumToString(bonus, s);
  242.                 MoveTo(gSAT.offSizeH - 47, 80);
  243.                 DrawString(MyGetIndString(bonusStrID)); {str 12: Bonus: }
  244.                 MoveTo(gSAT.offSizeH - 47, 100);
  245.                 DrawString(s);
  246.             end;
  247.  
  248.         NumToString(level, s);
  249.         MoveTo(gSAT.offSizeH - 47, 130);
  250.         DrawString(MyGetIndString(levelStrID)); {str 13: Level: }
  251.         MoveTo(gSAT.offSizeH - 47, 150);
  252.         DrawString(s);
  253.         InternalAddScore := r;
  254.     end;
  255.  
  256.     procedure AddScore (amount: longint);
  257.         var
  258.             s: str255;
  259.             r: Rect;
  260.             tmpport: grafptr;
  261.     begin
  262.         GetPort(tmpPort);
  263.         r := InternalAddScore(amount);
  264.         SATBackChanged(r); {Let SAT show it on screen}
  265.         SetPort(tmpPort);
  266.     end;
  267.  
  268.     procedure AddScoreS (amount: longint);
  269.         var
  270.             s: str255;
  271.             r: Rect;
  272.             tmpport: grafptr;
  273.     begin
  274.         GetPort(tmpPort);
  275.         r := InternalAddScore(amount);
  276.         CopyBits(gSAT.backScreen.port^.portbits, gSAT.wind.port^.portBits, r, r, srcCopy, nil);
  277.         CopyBits(gSAT.backScreen.port^.portbits, gSAT.offScreen.port^.portBits, r, r, srcCopy, nil);
  278.         SetPort(tmpPort);
  279.     end;
  280.  
  281.     procedure DoHighMenu (item: integer);
  282.         var
  283.             p: procptr;
  284.             i: integer;
  285.     begin
  286.         case item of
  287.             showhs: 
  288.                 begin
  289.                     ShowWindow(theHigh);
  290.                     SelectWindow(theHigh);
  291.                 end;
  292.             clearhs: 
  293.                 begin
  294.                     if SATQuestionStr(MyGetIndString(sureStrID)) then {str 14: Are you sure you want to erase the high scores?}
  295.                         begin
  296.                             for i := 1 to 10 do
  297.                                 begin
  298.                                     hs^^.HighScores[i] := 0;            { skall läsas från fil eller resurs }
  299.                                     hs^^.HighPlayer[i] := MyGetIndString(nobodyStrID); {str 15: Nobody}
  300.                                     hsm^^.HighScores[i] := 0;            { skall läsas från fil eller resurs }
  301.                                     hsm^^.HighPlayer[i] := MyGetIndString(nobodyStrID); {str 15}
  302.                                 end;
  303.                             hs^^.HighScores[0] := 10000;            { Lowscore }
  304.                             hsm^^.HighScores[0] := 10000;            { Lowscore }
  305.                             ChangedResource(handle(hs));
  306.                             ChangedResource(handle(hsm));
  307.                             HideWindow(theHigh);
  308.                         end;
  309.                 end;
  310.             otherwise
  311.                 ;
  312.         end;
  313.     end;
  314.  
  315.     procedure WindKey (theChar: char; theMods: integer);
  316.     begin
  317.     end;
  318.  
  319. { Call this on game over! }
  320.     procedure UpdateHigh;
  321.         var
  322.             num, len: integer;
  323.             name, s: str255;
  324.     begin
  325.         lastMacho := features^^.macho;
  326.  
  327.         if features^^.macho then
  328.             begin
  329.                 if score > hsm^^.HighScores[10] then
  330.                     begin
  331.                         num := 10;
  332.                         name := AskHigh;
  333.                         NumToString(level, s); {used below, to append level number}
  334. {Max 15 characters! We take some extra trouble to append '…' too.}
  335.                         len := length(stringof(' (', s, ')'));
  336.                         if length(name) > 15 - len then
  337.                             name := Concat(Copy(name, 1, 15 - len - 1), '…');
  338.  
  339.                         if name = '' then { alt length(name) = 0 }
  340.                             exit(updatehigh);
  341.                         while (hsm^^.HighScores[num - 1] < score) and (num > 1) do
  342.                             begin
  343.                                 hsm^^.HighScores[num] := hsm^^.HighScores[num - 1];
  344.                                 hsm^^.HighPlayer[num] := hsm^^.HighPlayer[num - 1];
  345.                                 num := num - 1;
  346.                             end;
  347.                         LastHigh := num; {Remember last high for the highscore display}
  348.                         hsm^^.HighScores[num] := score;
  349.                         hsm^^.HighPlayer[num] := stringof(name, ' (', s, ')'); {AskHigh;}
  350.                         ChangedResource(handle(hsm));
  351.                         HideWindow(theHigh);
  352.                         ShowWindow(theHigh);
  353.                         SelectWindow(theHigh);
  354.                     end;
  355.             end{ if macho }
  356.         else if score > hs^^.HighScores[10] then
  357.             begin
  358.                 num := 10;
  359.                 name := AskHigh;
  360.                 if length(name) > 15 then
  361.                     name := Concat(Copy(name, 1, 14), '…');
  362.  
  363.                 if name = '' then { alt length(name) = 0 }
  364.                     exit(updatehigh);
  365.                 while (hs^^.HighScores[num - 1] < score) and (num > 1) do
  366.                     begin
  367.                         hs^^.HighScores[num] := hs^^.HighScores[num - 1];
  368.                         hs^^.HighPlayer[num] := hs^^.HighPlayer[num - 1];
  369.                         num := num - 1;
  370.                     end;
  371.                 LastHigh := num; {Remember last high for the highscore display}
  372.                 hs^^.HighScores[num] := score;
  373.                 hs^^.HighPlayer[num] := name;
  374.                 ChangedResource(handle(hs));
  375.                 HideWindow(theHigh);
  376.                 ShowWindow(theHigh);
  377.                 SelectWindow(theHigh);
  378.             end;
  379.     end;
  380.  
  381.     procedure ZeroScore;
  382.     begin
  383.         score := 0;
  384.         LastHigh := -1;
  385.     end;
  386.  
  387. {This procedure copies a resource from the file applFile to prefFile (global file numbers,}
  388. {from the unit Preferences).}
  389. {OBSOLETE - should be replaced by the better code in Preferences.p!}
  390.     procedure OldCopyResource (resType: OSType; id: integer);
  391.         var
  392.             h, h2: Handle;
  393.             saveFile: integer;
  394.     begin
  395.         saveFile := CurResFile; {Look where we are so we can restore}
  396.         UseResFile(gAppFile);
  397.  
  398.         h := GetResource(resType, id); {Get res from the appl}
  399.         if h <> nil then
  400.             begin
  401.                 UseResFile(gPrefFile);
  402.                 h2 := GetResource(resType, id);
  403.                 if h2 = nil then {It doesn't already exist}
  404.                     begin
  405.                         DetachResource(h); {Detach it so we can move it.}
  406.                         AddResource(h, resType, id, ''); {Put it into the gPrefFile}
  407.                         ReleaseResource(h);
  408.                     end
  409.                 else {The res always exists. Don't copy.}
  410.                     begin
  411.                         ReleaseResource(h);
  412.                         ReleaseResource(h2);
  413.                     end;
  414.             end;
  415.         UseResFile(saveFile); {restore}
  416.     end;
  417.  
  418.     procedure InitScores;
  419.         var
  420.             i: integer;
  421.             ignoreErr: OSErr;
  422.     begin
  423.         if SetPrefFile(kPrefsFileName, kPrefCreator, kPrefType, gAppFile, gPrefFile, false) then {If a pref file was created, copy high scores to it!}
  424.             begin
  425.                 ignoreErr := CopyResource(gAppFile, gPrefFile, 'Bäst', 0); {Normal mode high scores}
  426.                 ignoreErr := CopyResource(gAppFile, gPrefFile, 'Bäst', 1); {Macho mode high scores}
  427.                 ignoreErr := CopyResource(gAppFile, gPrefFile, 'Feat', 0); {Settings}
  428.             end
  429.         else
  430.             gPrefFile := gAppFile; {If we have no pref file, let's make sure we UseResFile to something that exists.}
  431.  
  432.         lastHigh := -1; {no "last"}
  433.  
  434.         theHigh := GetNewWindow(theHighRes, nil, WindowPtr(-1));
  435.         SetPort(theHigh);
  436.         dummy := SkelWindow(theHigh, nil, @WindKey, @HighUpdate, nil, nil, @HighHalt, nil, false);
  437.  
  438.         UseResFile(gPrefFile); {set the resfile to the pref file, if any. If none, gPrefFile will be the app itself!}
  439.  
  440.         hs := hsHnd(GetResource('Bäst', 0));
  441.         if hs = nil then {Didn't exist - create it!}
  442.             begin
  443.                 hs := hsHnd(NewHandle(Sizeof(hsRec)));
  444.                 CheckNoMem(Ptr(hs));
  445.                 for i := 1 to 10 do
  446.                     begin
  447.                         hs^^.HighScores[i] := 0;
  448.                         hs^^.HighPlayer[i] := MyGetIndString(nobodyStrID); {str 15}
  449.                     end;
  450.                 hs^^.HighScores[0] := 10000;            { Lowscore }
  451.                 AddResource(handle(hs), 'Bäst', 0, 'High scores');
  452.             end
  453.         else {Did exist - check the size!}
  454.             if GetHandleSize(Handle(hs)) < sizeof(hsHnd) then
  455.                 SetHandleSize(Handle(hs), sizeof(hsHnd));
  456.  
  457.         hsm := hsHnd(GetResource('Bäst', 1));
  458.         if hsm = nil then {Didn't exist - create it!}
  459.             begin
  460.                 hsm := hsHnd(NewHandle(Sizeof(hsRec)));
  461.                 CheckNoMem(Ptr(hsm));
  462.                 for i := 1 to 10 do
  463.                     begin
  464.                         hsm^^.HighScores[i] := 0;            { skall läsas från fil eller resurs }
  465.                         hsm^^.HighPlayer[i] := MyGetIndString(nobodyStrID); {str 15}
  466.                     end;
  467.                 hsm^^.HighScores[0] := 10000;            { Lowscore }
  468.                 AddResource(handle(hsm), 'Bäst', 1, 'High scores');
  469.             end
  470.         else {Did exist - check the size!}
  471.             if GetHandleSize(Handle(hsm)) < sizeof(hsHnd) then
  472.                 SetHandleSize(Handle(hsm), sizeof(hsHnd));
  473.  
  474.         UseResFile(gAppFile);
  475.  
  476.         score := 0;
  477.     end;
  478.  
  479. end.